Optional Quicksort.f

Requires Quotations

Only Forth Definitions

\ Credit: Wil Baden
\ Source: http://en.literateprograms.org/Quicksort_(Forth)

\ Can support comparison of indirect values (such as the Z coordinate of a Entity) by reassigning VAL@ to
\   a bit of code that will fetch the field of the object in the list.

\   Usage:  :noname  ( addr -- n ) <code>  ; is val@
\           <cell array> sort


defer comparison ( a@ b@ -- ? )   ' < is comparison
defer val@ ' NOOP is val@


: mid ( l r -- mid ) over - 2/ -cell and + ;

: exch ( addr1 addr2 -- ) dup @ >r over @ swap ! r> swap ! ;

: part ( l r -- l r r2 l2 )
  2dup mid @ val@ >r ( r: pivot )
  2dup begin
    swap begin dup @ val@  r@ comparison while cell+ repeat
    swap begin r@ over @ val@ comparison while cell- repeat
    2dup <= if 2dup exch >r cell+ r> cell- then
  2dup > until  r> drop ;

: qsort ( l r -- )
  part  swap rot
  \ 2over 2over - + < if 2swap then
  2dup < if recurse else 2drop then
  2dup < if recurse else 2drop then ;

: sort ( array len -- )
  \ dup 2 < if 2drop exit then
  1- cells over + qsort ;

:[] sort:[  ( array len xt -- )
  is val@ ?dup if sort else drop then ;

\\ Test

create v0 9999 ,
create v1 1234 ,
create v2 329849 ,
create v3 -12 ,
create v4 5283 ,
create v5 33 ,


create test v0 , v1 , v2 , v3 , v4 , v5 ,

:noname  @ ; is val@

: main
  test 6 sort
  6 0 do test i cells + @ @ . loop cr ;

